;;; $Id: log.sld 347 2013-12-03 20:03:23Z alan.watson.f $

(define-library (oaxaca log)

  (export log-info
          log-error)

  (import (scheme base)
          (scheme process-context)
          (scheme write))
          
  (import (prefix (oaxaca foreign) foreign:))

  (begin

    (define (log-line message . rest)
      (parameterize ((current-output-port (open-output-string)))
        (display message)
        (for-each
         (lambda (x)
           (if (procedure? x)
             (x)
             (display x)))
         rest)
        (get-output-string (current-output-port))))

    (define (log-error-object logger error-object)
      (log logger (error-object-message error-object))
      (case (length (error-object-irritants error-object))
        ((0))
        ((1)
         (log logger "irritant is:")
         (log logger (lambda () (write (car (error-object-irritants error-object))))))
        (else
         (log logger "irritants are:")
         (for-each
          (lambda (irritant)
            (log logger (lambda () (write irritant))))
          (error-object-irritants error-object)))))

    (define (log logger message . rest)
      (if (and (error-object? message) (null? rest))
        (log-error-object logger message)
        (logger (apply log-line message rest))))

    (define (log-info message . rest)
      (apply log foreign:info message rest))

    (define (log-error message . rest)
      (apply log foreign:error message rest))))
